home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tix4.1 / DirList.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  7.2 KB  |  287 lines
  1. # DirList.tcl --
  2. #
  3. #    Implements the tixDirList widget.
  4. #
  5. #        - overrides the -browsecmd and -command options of the
  6. #         HList subwidget
  7. #
  8. # Copyright (c) 1996, Expert Interface Technologies
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13.  
  14. tixWidgetClass tixDirList {
  15.     -classname TixDirList
  16.     -superclass tixScrolledHList
  17.     -method {
  18.     chdir
  19.     }
  20.     -flag {
  21.      -browsecmd -command -dircmd -disablecallback 
  22.      -root -rootname -showhidden -value
  23.     }
  24.     -configspec {
  25.     {-browsecmd browseCmd BrowseCmd ""}
  26.     {-command command Command ""}
  27.     {-dircmd dirCmd DirCmd ""}
  28.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  29.     {-root root Root ""}
  30.     {-rootname rootName RootName ""}
  31.     {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
  32.     {-value value Value ""}
  33.     }
  34.     -default {
  35.     {.scrollbar            auto}
  36.     {*borderWidth            1}
  37.     {*hlist.background        #c3c3c3}
  38.     {*hlist.indent            7}
  39.     {*hlist.relief            sunken}
  40.     {*hlist.height            10}
  41.     {*hlist.width            20}
  42.     {*hlist.padX            2}
  43.     {*hlist.padY            0}
  44.     {*hlist.wideSelection        0}
  45.     {*hlist.drawBranch        0}
  46.     {*hlist.highlightBackground    #d9d9d9}
  47.     {*hlist.itemType        imagetext}
  48.     {*hlist.takeFocus        1}
  49.     }
  50.     -forcecall {
  51.     -value
  52.     }
  53. }
  54.  
  55. # Important data members:
  56. #
  57. # data(vpath)
  58. #    The currently selected vpath. This internal variable is useful on
  59. #    the Win95 platform, where an directory may correspond to more than
  60. #    one node in the hierarchy. For example, C:\Windows\Desktop\Foo
  61. #    can appead as "Desktop\Foo" and
  62. #    "Desktop\My Computer\C:\Windows\Desktop\Foo". This variable tells us
  63. #    which icon should we show given the same DOS pathname.
  64. #
  65.  
  66. proc tixDirList:InitWidgetRec {w} {
  67.     upvar #0 $w data
  68.  
  69.     tixChainMethod $w InitWidgetRec
  70. }
  71.  
  72. proc tixDirList:ConstructWidget {w} {
  73.     upvar #0 $w data
  74.  
  75.     tixChainMethod $w ConstructWidget
  76.  
  77.     $data(w:hlist) config \
  78.     -separator [tixFSSep] \
  79.     -selectmode "single"
  80.  
  81.     # We must creat an extra copy of these images to avoid flashes on
  82.     # the screen when user changes directory
  83.     #
  84. #    set data(images) [image create compound -window $data(w:hlist)]
  85. #    $data(images) add image -image [tix getimage act_fold]
  86. #    $data(images) add image -image [tix getimage folder]
  87. #    $data(images) add image -image [tix getimage openfold]
  88. }
  89.  
  90. proc tixDirList:SetBindings {w} {
  91.     upvar #0 $w data
  92.  
  93.     tixChainMethod $w SetBindings
  94.  
  95.     $data(w:hlist) config \
  96.     -browsecmd "tixDirList:Browse $w" \
  97.     -command "tixDirList:Command $w"
  98.  
  99.     if [tixStrEq $data(-value) ""] {
  100.     set data(-value) [tixFSPWD]
  101.     }
  102.     if [catch {
  103.     set data(vpath) [tixFSVPath [tixFSNormDir $data(-value)]]
  104.     }] {
  105.     set data(vpath) [tixFSVPath [tixFSNormDir [tixFSPWD]]]
  106.     }
  107. }
  108.  
  109. #----------------------------------------------------------------------
  110. # Incoming-Events
  111. #----------------------------------------------------------------------
  112. proc tixDirList:Browse {w args} {
  113.     upvar #0 $w data
  114.  
  115.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  116.     set vpath [tixEvent flag V]
  117.     set value [$data(w:hlist) info data $vpath]
  118.  
  119.     tixDirList:HighLight $w $vpath
  120.  
  121.     set data(vpath)  $vpath
  122.     set data(-value) $value
  123.  
  124.     tixDirList:CallBrowseCmd $w $data(-value)
  125. }
  126.  
  127. proc tixDirList:Command {w args} {
  128.     upvar #0 $w data
  129.  
  130.     set vpath [tixEvent value]
  131.     set value [$data(w:hlist) info data $vpath]
  132.     set data(-value) $value
  133.  
  134.     tixDirList:LoadDir $w [tixFSNormDir $value] $vpath
  135.     tixDirList:HighLight $w $vpath
  136.  
  137.     set data(vpath) $vpath
  138.     tixDirList:CallCommand $w $data(-value)
  139. }
  140.  
  141. #----------------------------------------------------------------------
  142. # Outgoing-Events
  143. #----------------------------------------------------------------------
  144.  
  145. proc tixDirList:CallBrowseCmd {w value} {
  146.     upvar #0 $w data
  147.  
  148.     if {$data(-browsecmd) != ""} {
  149.     set bind(specs) "%V"
  150.     set bind(%V) $value
  151.     tixEvalCmdBinding $w $data(-browsecmd) bind $value
  152.     }
  153. }
  154.  
  155. proc tixDirList:CallCommand {w value} {
  156.     upvar #0 $w data
  157.  
  158.     if {$data(-command) != "" && !$data(-disablecallback)} {
  159.     set bind(specs) "%V"
  160.     set bind(%V) $value
  161.     tixEvalCmdBinding $w $data(-command) bind $value
  162.     }
  163. }
  164.  
  165. #----------------------------------------------------------------------
  166. #         Directory loading
  167. #----------------------------------------------------------------------
  168. proc tixDirList:LoadDir {w {npath ""} {vpath ""}} {
  169.     upvar #0 $w data
  170.  
  171.     tixBusy $w on $data(w:hlist)
  172.  
  173.     $data(w:hlist) delete all
  174.  
  175.     if {![string compare $npath ""]} {
  176.     set npath [tixFSNormDir $data(-value)]
  177.     set vpath [tixFSVPath $npath]
  178.     }
  179.  
  180.     tixDirList:ListHierachy $w $npath $vpath
  181.     tixDirList:ListSubDirs $w $npath $vpath
  182.  
  183.     tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
  184. }
  185.  
  186. proc tixDirList:ListHierachy {w dir vpath} {
  187.     upvar #0 $w data
  188.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  189.  
  190.     foreach p [tixFSSplit $vpath] {
  191.     set vpath [lindex $p 0]
  192.     set text  [lindex $p 1]
  193.     set path  [lindex $p 2]
  194.  
  195.     $data(w:hlist) add $vpath -text $text -data $path \
  196.         -image [tix getimage openfold]
  197.     }
  198. }
  199.  
  200. proc tixDirList:ListSubDirs {w dir vpath} {
  201.     upvar #0 $w data
  202.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  203.  
  204.     $data(w:hlist) entryconfig $vpath \
  205.     -image [tix getimage act_fold]
  206.  
  207.     foreach ent [tixFSListDir $vpath 1 0 0 $data(-showhidden)] {
  208.     set vp   [lindex $ent 0]
  209.     set name [lindex $ent 1]
  210.     set path [lindex $ent 2]
  211.  
  212.     $data(w:hlist) add $vp -text $name -data $path \
  213.         -image [tix getimage folder]
  214.     }
  215. }
  216.  
  217. proc tixDirList:SetValue {w npath vpath {flag ""}} {
  218.     upvar #0 $w data
  219.  
  220.     if {![string compare $flag reload] ||
  221.     ![$data(w:hlist) info exists $vpath]} {
  222.         tixDirList:LoadDir $w $npath $vpath
  223.     }
  224.  
  225.     tixDirList:HighLight $w $vpath
  226.  
  227.     set data(-value) [tixFSDisplayName $npath]
  228.     set data(vpath) $vpath
  229.     tixDirList:CallCommand $w $data(-value)
  230. }
  231.  
  232. proc tixDirList:HighLight {w vpath} {
  233.     upvar #0 $w data
  234.  
  235.     if {![tixStrEq $data(vpath) $vpath]} {
  236.     set old $data(vpath)
  237.  
  238.     if [$data(w:hlist) info exists $old] {
  239.         # Un-highlight the originally selected entry by changing its
  240.         # folder image
  241.  
  242.         if {[$data(w:hlist) info children $old] == ""} {
  243.         $data(w:hlist) entryconfig $old\
  244.             -image [tix getimage folder]
  245.         } else {
  246.         $data(w:hlist) entryconfig $old\
  247.             -image [tix getimage openfold]
  248.         }
  249.     }
  250.     }
  251.  
  252.     # Highlight the newly selected entry
  253.     #
  254.     $data(w:hlist) entryconfig $vpath \
  255.     -image [tix getimage act_fold]
  256.     $data(w:hlist) anchor set $vpath
  257.     $data(w:hlist) select clear
  258.     $data(w:hlist) select set $vpath
  259.     $data(w:hlist) see $vpath
  260. }
  261.  
  262. #----------------------------------------------------------------------
  263. # Config options
  264. #----------------------------------------------------------------------
  265. proc tixDirList:config-value {w value} {
  266.     upvar #0 $w data
  267.  
  268.     tixDirList:chdir $w $value
  269.     return $data(-value)
  270. }
  271.  
  272. proc tixDirList:config-showhidden {w value} {
  273.     upvar #0 $w data
  274.  
  275.     tixWidgetDoWhenIdle tixDirList:LoadDir $w
  276. }
  277.  
  278. #----------------------------------------------------------------------
  279. # Public methods
  280. #----------------------------------------------------------------------
  281. proc tixDirList:chdir {w value} {
  282.     upvar #0 $w data
  283.  
  284.     set path [tixFSNormDir $value]
  285.     tixDirList:SetValue $w $path [tixFSVPath $path]
  286. }
  287.